home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / TAIL.4TH < prev    next >
Text File  |  1994-10-30  |  5KB  |  191 lines
  1. \ TAIL PROGRAM, BY TOM ALMY.
  2.  
  3. \ THIS PROGRAM IS COPYRIGHT (C) 1985 BY TOM ALMY,
  4. \ ALL RIGHTS RESERVED.
  5. \  Users of ForthCMP are given permission to use or distribute this
  6. \  program, as long as no charge is made and the credit message is maintained.
  7.  
  8. 100 MSDOS
  9. HEX 1000 DECIMAL CONSTANT BUFSIZ
  10. INCLUDE FILTER
  11.  
  12.  
  13. \ DATA DECLARATIONS
  14. CTRL J CONSTANT NL    \ line delimiter character
  15. VARIABLE +FLAG        \ flags in option string
  16. VARIABLE CFLAG
  17. VARIABLE RFLAG
  18. 2VARIABLE LCOUNT
  19. 2VARIABLE OFFSET    \ Offset into file of pointer
  20. VARIABLE RLINEBUF    \ reverse line buffer
  21.  
  22. \ MESSAGES
  23. 0 0 IN/OUT 
  24. : NOTICE  CONSOLE  
  25.    ." TAIL PRINTING PROGRAM " CR
  26.    ." COPYRIGHT (C) 1985 BY THOMAS ALMY " CR ;
  27.  
  28. 0 0 IN/OUT 
  29. : USAGE   CONSOLE CR
  30.  ." USAGE:  TAIL [-[+][n][C][R]] [srcfile] [destfile]" CR
  31.  ." where srcfile is an ascii source file, or - for standard input" CR
  32.  ." and destfile is output file." CR
  33.  ." + --> type leading lines instead of tail" CR
  34.  ." n --> line count (default to 10)" CR
  35.  ." C --> `n' is character count" CR
  36.  ." R --> output lines backwards (+ or C ignored)" CR 
  37.  ABORT ;
  38.  
  39. 0 1 IN/OUT
  40. : MORE-LINES? ( -- true if more lines )
  41.   LCOUNT 2@ 2DUP OR -ROT -1. D+ LCOUNT 2! ;
  42.  
  43. 1 0 IN/OUT
  44. : ?DIE  IF CONSOLE ." I/O ERROR" ABORT THEN ;
  45.  
  46.  
  47.  
  48. \ routines for reverse reading
  49.  
  50. 0 1 IN/OUT
  51. : BACKREAD ( -- bofflag )
  52.    OFFSET 2@ OR 0= IF TRUE EXIT THEN ( backed up to start already )
  53.    OFFSET 2@ BUFSIZ 0 D- OFFSET 2!
  54.    infile OFFSET 2@ 0 FSEEK 2DROP ( back file up )
  55.    infile inbuffer @ BUFSIZ FREAD DUP BUFSIZ <> ?DIE 
  56.    inbuffer @ +  DUP inbufend !  inbufptr ! ( start at end of buffer )
  57.    FALSE
  58.    ;
  59.    
  60. 0 0 IN/OUT
  61. : INIT-REVERSE
  62.   infile 0 0 2 FSEEK  OFFSET 2! ( compute file size )
  63.   OFFSET CELL+ @  BUFSIZ 1- AND ?DUP IF ( short first buffer? )
  64.       DUP NEGATE OFFSET CELL+ +! ( adjust offset )
  65.         infile OFFSET 2@ 0 FSEEK 2DROP
  66.       infile inbuffer @ 2 PICK FREAD TUCK <> ?DIE
  67.       inbuffer @ + DUP inbufend ! inbufptr !
  68.   ELSE
  69.     inbuffer @ inbufptr !
  70.       BACKREAD DROP 
  71.   THEN ;
  72.  
  73. 0 1 IN/OUT
  74. : -KEY ( -- key or -1 if BOF )
  75.   inbuffer @ inbufptr @ = IF BACKREAD IF TRUE EXIT THEN THEN
  76.   -1 inbufptr +!
  77.   inbufptr @ C@  ;
  78.  
  79.  
  80. \ Copying routines
  81. 0 0 IN/OUT
  82. : +COPY                 \ Copy in forward direction
  83.   CFLAG @ IF ( by character )
  84.     BEGIN
  85.       MORE-LINES? WHILE ( non-zero so move a character )
  86.       KEY DUP 0< 0= IF EMIT ELSE DROP EXIT THEN
  87.     REPEAT
  88.   ELSE  ( by line )
  89.     BEGIN
  90.       MORE-LINES? WHILE ( non-zero so move a line )
  91.         BEGIN KEY DUP 0< IF DROP EXIT THEN
  92.            DUP NL <> WHILE
  93.            EMIT
  94.         REPEAT EMIT
  95.     REPEAT  THEN ;
  96.  
  97.  
  98. 0 0 IN/OUT
  99. : RCOPY                 \ Reverse copy
  100.   2 ALLOT
  101.   HERE RLINEBUF !  
  102.   256 ALLOT ( allot our storage )
  103.   INIT-REVERSE ( will go backwards )
  104.   -KEY 0< IF EXIT THEN ( quit if nothing )
  105.   BEGIN MORE-LINES? WHILE  RLINEBUF @ ( end of line )
  106.       BEGIN -KEY DUP 0< 0= OVER NL <> AND WHILE
  107.        OVER C! 1+ REPEAT  ( buffer, key )  SWAP
  108.       BEGIN  DUP RLINEBUF @  <> WHILE
  109.             1- DUP C@ EMIT 
  110.       REPEAT DROP
  111.       NL EMIT 
  112.       TRUE = IF EXIT THEN
  113.   REPEAT  ;
  114.  
  115.  
  116.  
  117. 0 0 IN/OUT
  118. : BACK-LINES    \ Search backwards from end by lines
  119.     INIT-REVERSE
  120.     BEGIN BEGIN -KEY DUP 0< IF DROP  EXIT THEN
  121.                  NL = UNTIL
  122.           MORE-LINES? 0= UNTIL
  123.     KEY DROP ;
  124.  
  125. 0 0 IN/OUT
  126. : BACK-CHARS    \ Tricky search backwards by characters 
  127.    infile 0 0 2 FSEEK LCOUNT 2@ DMIN DNEGATE 
  128.    infile -ROT 1 FSEEK 2DROP ;
  129.  
  130. 0 0 IN/OUT
  131. : -COPY                 \ Copy final lines/characters
  132.    CFLAG @ IF BACK-CHARS ELSE BACK-LINES THEN
  133.    BEGIN KEY DUP 0< 0= WHILE
  134.          EMIT REPEAT  DROP ;
  135.  
  136.  
  137. \ Parse Command stream
  138.  
  139. 1 0 IN/OUT
  140. : BAD-OPTION \ Just print the error message then quit
  141.    CONSOLE CR ." BAD OPTION - " EMIT USAGE ;
  142.  
  143. 0 0 IN/OUT
  144. : READ-OPTIONS
  145.   +FLAG OFF 
  146.   CFLAG OFF 
  147.   RFLAG OFF 
  148.   10. LCOUNT 2!
  149.   OPTIONSTRING 2@ 0 ?DO  COUNT 
  150.   DUP [CHAR] a >= IF BL - THEN CASE
  151.     [CHAR] C OF CFLAG ON  1 ENDOF
  152.     [CHAR] + OF +FLAG ON  1 ENDOF  
  153.     [CHAR] R OF RFLAG ON  1 ENDOF
  154.         DUP [CHAR] 0 >= OVER [CHAR] 9 <= AND IF
  155.           DROP DUP >R CELL- 0. ROT CONVERT -ROT LCOUNT 2! DUP R> - 1+ 0
  156.           ELSE BAD-OPTION THEN  ENDCASE
  157.       +LOOP DROP ;
  158.  
  159.  
  160. 1 1 IN/OUT
  161. CODE SERIAL? ( handle -- TRUE if serial device )
  162. HEX
  163.     AX BX MOV
  164.     4400 # AX MOV
  165.     21 INT
  166.     DX AX MOV
  167.     80 # AX AND
  168.     RET
  169. END-CODE
  170.  
  171. \ MAIN ROUTINE
  172. : MAIN
  173.     SETBUFS
  174.     NOTICE
  175.     SETFILES infile HCB>H SERIAL? OR IF USAGE THEN
  176.     READ-OPTIONS
  177.     RFLAG @ IF 
  178.         RCOPY 
  179.     ELSE
  180.         +FLAG @ IF 
  181.             +COPY 
  182.         ELSE 
  183.             -COPY 
  184.         THEN 
  185.     THEN
  186.     BYE ;
  187.  
  188. INCLUDE DOS2
  189. INCLUDE FORTHLIB
  190. END
  191.